home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / sunpro / sunpro-init.el.z / sunpro-init.el
Encoding:
Text File  |  1998-05-21  |  6.6 KB  |  192 lines
  1. ;;; No byte-compiler warnings
  2. ;(eval-when-compile
  3. ;  (require 'w3))
  4.  
  5. ;;; Keep these obsolete variables for backward compatibility
  6. (defconst era-version "0.95" "\
  7. Version numbers of this version of Era.")
  8.  
  9. ;; We're (not really anymore) calling this version Sun Era.
  10. (defconst sun-era t)
  11.  
  12. (defun era-version ()
  13.   "Return (obsolete) string describing the version of Era that is running.
  14. Era is now known as XEmacs.  Use (emacs-version) instead."
  15.   (interactive)
  16.   (if (interactive-p)
  17.       (message "%s" (era-version))
  18.     (format "%sEra %s of %s %s on %s (%s)"
  19.         (if sun-era "Sun " "")
  20.         era-version
  21.         (substring emacs-build-time 0
  22.                (string-match " *[0-9]*:" emacs-build-time))
  23.         (substring emacs-build-time
  24.                        (string-match "[0-9]*$" emacs-build-time))
  25.         emacs-build-system system-type)))
  26.  
  27. ;(defun sunpro-maybe-connect-to-tooltalk ()
  28. ;  (if (and (not (noninteractive))
  29. ;       (fboundp 'command-line-do-tooltalk))
  30. ;      (command-line-do-tooltalk nil)))
  31.  
  32. ;; sunpro-maybe-connect-to-tooltalk must appear in the hook list
  33. ;; before any clients that register patterns, like eos-load.el.
  34. ;; Currently eos-load.el places its functions at the end of the list
  35.  
  36. ;(add-hook 'before-init-hook 'sunpro-maybe-connect-to-tooltalk)
  37.  
  38. (set-glyph-image text-pointer-glyph    "xterm")
  39. (set-glyph-image nontext-pointer-glyph "xterm")
  40.  
  41. ;; W3 doesn't know about using pageview, so let's fix that.
  42. ;; There doesn't seem to be any such function `w3-parse-mailcap' - mrb
  43.  
  44. ;(defun sunpro-fix-postscript-viewer ()
  45. ;  (if (not (noninteractive))
  46. ;    (condition-case nil
  47. ;      (w3-parse-mailcap
  48. ;        (expand-file-name "sparcworks/sunpro-mailcap" data-directory))
  49. ;      (error nil))))
  50.  
  51. ;(add-hook 'w3-load-hooks 'sunpro-fix-postscript-viewer)
  52.  
  53. ;; turn on pending delete without messing up its autoloads
  54. ;(defun sunpro-pending-delete-on ()
  55. ;  (if (not (noninteractive))
  56. ;      (pending-delete-on nil)))
  57.  
  58. ;(add-hook 'before-init-hook 'sunpro-pending-delete-on)
  59.  
  60. ;;; Decide whether to use workshop.el or eos at runtime, based on
  61. ;;; which Sun DevPro products are installed.
  62.  
  63. (defun sunpro-update-paths-for-workshop ()
  64.   "Update exec-path and load-path to find supporting workshop files.
  65. Returns nil if the required files cannot be found."
  66.   (and
  67.    (cond
  68.     ((locate-file "workshop.el" load-path))
  69.     
  70.     ((file-exists-p (concat sunpro-dir "lib/workshop.el"))
  71.      (setq load-path (append load-path (list (concat sunpro-dir "lib/"))))))
  72.    
  73.    (cond
  74.     ((locate-file "workshop" exec-path))
  75.     
  76.     ((file-exists-p (concat sunpro-dir "bin/workshop"))
  77.      (setq exec-path (append exec-path (list (concat sunpro-dir "bin/"))))))))
  78.  
  79. (defun sunpro-startup ()
  80.   "Runs at startup if support for Sun Workshop is compiled in.  Don't run this."
  81.   
  82.   ;; Sun distribution censors yow, among other things...
  83.   (unless (locate-file "yow.el" load-path)
  84.     (fmakunbound 'yow)
  85.     (delete-menu-item '("Apps" "Games" "Quote from Zippy"))
  86.     (delete-menu-item '("Apps" "Games" "Psychoanalyze Zippy!")))
  87.   
  88.   (when (not (noninteractive))
  89.  
  90.     (flet
  91.         ((sunpro-dir-p (dir)
  92.                        (and dir
  93.                             (file-exists-p (concat dir "bin/workshop"))
  94.                             (file-exists-p (concat dir "lib/workshop.el")))))
  95.       (defconst sunpro-dir
  96.         (cond
  97.          ;; Look on the PATH
  98.          ((let ((path exec-path) dir (found nil))
  99.             (while (and path (not found))
  100.               (setq dir (or (car path) "."))
  101.               (setq path (cdr path))
  102.               (setq dir (concat dir (if (string-match "/$" dir) "../" "/../")))
  103.               (setq found (sunpro-dir-p dir)))
  104.             (if found
  105.                 (expand-file-name dir))))
  106.  
  107.          ;; Check for standard Sun DevPro CD Install layout
  108.          ((if (string-match "contrib/[^/]+/[^/]+/[^/]+/[^/]+/$" exec-directory)
  109.               (let ((dir (substring exec-directory 0 (match-beginning 0))))
  110.                 (if (sunpro-dir-p dir)
  111.                     (expand-file-name dir)))))
  112.          
  113.          ;; Default install location
  114.          ("/opt/SUNWspro/"))
  115.  
  116.         "Directory where Sun Developer Products are installed."))
  117.  
  118.     ;; Sunpro ships the mule version as a 2-file addition to the
  119.     ;; non-mule distribution - the binary and the doc file.
  120.     ;;
  121.     ;; This is a quick hack, I know...
  122.     ;; There ought to be a better way to do this.
  123.     ;; Perhaps a --xemacs-flavor=mule flag?
  124.     (if (featurep 'mule)
  125.         (let ((mule-doc-file-name (concat internal-doc-file-name "-mule")))
  126.           (if (file-exists-p (concat doc-directory mule-doc-file-name))
  127.               (setq internal-doc-file-name mule-doc-file-name))))
  128.  
  129.     ;; Connect to tooltalk, but only on an X server.
  130.     (when (and (featurep 'tooltalk)
  131.            (fboundp 'command-line-do-tooltalk)
  132.            (eq 'x (device-type)))
  133.       (command-line-do-tooltalk nil))
  134.     
  135.     ;; Sun's pending-del default is like textedit's
  136.     (require 'pending-del)
  137.     (turn-on-pending-delete)
  138.     
  139.     ;; Bar cursor 2 pixels wide
  140.     (setq bar-cursor 2)
  141.  
  142.     ;; Nice CDE compliant icon -- now the default...
  143.     ;;(if (featurep 'xpm)
  144.     ;;    (set-glyph-image
  145.     ;;     frame-icon-glyph
  146.     ;;     (format "%s%s" data-directory "xemacs-icon3.xpm")
  147.     ;;     'global 'x))
  148.     
  149.     (cond
  150.      ;; Use Sun WorkShop if available
  151.      ((sunpro-update-paths-for-workshop)
  152.       ;; Unfortunately, changes to the default toolbar in 20.3 b21
  153.       ;; have broken workshop-frob-toolbar in workshop.el.  Since new
  154.       ;; XEmacsen have to work with older WorkShops, this must be
  155.       ;; fixed both in workshop.el (distributed on the Sun WorkShop CD)
  156.       ;; and worked-around here.
  157.       (set-specifier default-toolbar
  158.              (append (specifier-instance default-toolbar)
  159.                  `([,(toolbar-make-button-list nil)
  160.                 workshop-bugfix nil nil])))
  161.       (require 'workshop)
  162.       (set-specifier default-toolbar
  163.              (delete-if (lambda (b) (eq (aref b 1) 'workshop-bugfix))
  164.                 (specifier-instance default-toolbar))))
  165.  
  166.      ;; Else, use eos package with sparcworks if available
  167.      ((or
  168.        (locate-file "sparcworks" exec-path)
  169.        (prog1
  170.            (file-exists-p (concat sunpro-dir "bin/sparcworks"))
  171.          (setq exec-path (append exec-path (list (concat sunpro-dir "bin/"))))))
  172.       
  173.       (load "sun-eos-init")
  174.       (load "sun-eos-common")
  175.       (load "sun-eos-editor")
  176.       (load "sun-eos-browser")
  177.       (load "sun-eos-debugger")
  178.       (load "sun-eos-debugger-extra")
  179.       (load "sun-eos-menubar")
  180.       (eos::start))
  181.      
  182.      (t ; Neither? Complain...
  183.       (display-warning
  184.        'sunpro
  185.        "XEmacs was compiled with support for Sun Developer Products,
  186. but neither `workshop' nor `sparcworks' were found on the PATH.")))
  187.     ))
  188.  
  189. (add-hook 'before-init-hook 'sunpro-startup)
  190.  
  191. (provide 'sunpro)
  192.